home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE10 / FILES / STRM3U.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-29  |  3.7 KB  |  178 lines
  1. unit Strm3u;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;
  8.  
  9. type
  10.   TPointList = class(TComponent)
  11.   protected
  12. {$ifdef Windows}
  13.     procedure WriteComponents(Writer: TWriter); override;
  14. {$else}
  15.     procedure GetChildren(Proc: TGetChildProc); override;
  16. {$endif}
  17.   end;
  18.  
  19.   TPointData = class(TComponent)
  20.   private
  21.     FX, FY: Word;
  22. {$ifdef Windows}
  23.   protected
  24.     function HasParent: Boolean; override;
  25. {$endif}
  26.   public
  27.     constructor CreateXY(AOwner: TComponent; AX, AY: Word);
  28.     procedure SwapXY;
  29.   published
  30.     property X: Word read FX write FX default 0;
  31.     property Y: Word read FY write FY default 0;
  32.   end;
  33.  
  34.   TForm1 = class(TForm)
  35.     PaintBox1: TPaintBox;
  36.     Bevel1: TBevel;
  37.     MakeBtn: TButton;
  38.     SaveBtn: TButton;
  39.     LoadBtn: TButton;
  40.     SwapBtn: TButton;
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure PaintBox1Paint(Sender: TObject);
  43.     procedure MakeBtnClick(Sender: TObject);
  44.     procedure SaveBtnClick(Sender: TObject);
  45.     procedure LoadBtnClick(Sender: TObject);
  46.     procedure SwapBtnClick(Sender: TObject);
  47.   private
  48.     PointList: TPointList;
  49.     procedure ClearPoints;
  50.   end;
  51.  
  52. var
  53.   Form1: TForm1;
  54.   Pt: TPointData;
  55.   Loop: Integer;
  56.  
  57. const
  58.   DataFile = 'POINTS3.DAT';
  59.  
  60. implementation
  61.  
  62. {$R *.DFM}
  63.  
  64. {$ifdef Windows}
  65. procedure TPointList.WriteComponents(Writer: TWriter);
  66. var
  67.   Loop: Integer;
  68. begin
  69.   { inherited version does nothing - no need to call it }
  70.   for Loop := 0 to ComponentCount - 1 do
  71.     Writer.WriteComponent(Components[Loop]);
  72. end;
  73. {$else}
  74. procedure TPointList.GetChildren(Proc: TGetChildProc);
  75. var
  76.   Loop: Integer;
  77. begin
  78.   { inherited version does nothing - no need to call it }
  79.   for Loop := 0 to ComponentCount - 1 do
  80.     Proc(Components[Loop]);
  81. end;
  82. {$endif}
  83.  
  84. constructor TPointData.CreateXY(AOwner: TComponent; AX, AY: Word);
  85. begin
  86.   inherited Create(AOwner);
  87.   FX := AX;
  88.   FY := AY;
  89. end;
  90.  
  91. {$ifdef Windows}
  92. function TPointData.HasParent: Boolean;
  93. begin
  94.   Result := True;
  95. end;
  96. {$endif}
  97.  
  98. procedure TPointData.SwapXY;
  99. begin
  100.   Tag := FX;
  101.   FX := FY;
  102.   FY := Tag;
  103. end;
  104.  
  105. procedure TForm1.ClearPoints;
  106. begin
  107.   PointList.DestroyComponents
  108. end;
  109.  
  110. procedure TForm1.FormCreate(Sender: TObject);
  111. begin
  112.   PointList := TPointList.Create(Self);
  113. end;
  114.  
  115. procedure TForm1.PaintBox1Paint(Sender: TObject);
  116. begin
  117.   for Loop := 0 to PointList.ComponentCount - 1 do
  118.   begin
  119.     Pt := PointList.Components[Loop] as TPointData;
  120.     if Loop = 0 then
  121.       PaintBox1.Canvas.MoveTo(Pt.X, Pt.Y)
  122.     else
  123.       PaintBox1.Canvas.LineTo(Pt.X, Pt.Y)
  124.   end;
  125. end;
  126.  
  127. procedure TForm1.MakeBtnClick(Sender: TObject);
  128. begin
  129.   ClearPoints;
  130.   for Loop := 1 to Random(40) + 1 do
  131.   begin
  132.     Pt := TPointData.CreateXY(PointList,
  133.             Random(PaintBox1.Width),
  134.             Random(PaintBox1.Height));
  135.     PaintBox1.Invalidate;
  136.   end;
  137. end;
  138.  
  139. procedure TForm1.SaveBtnClick(Sender: TObject);
  140. var
  141.   Stream: TFileStream;
  142. begin
  143.   Stream := TFileStream.Create(DataFile, fmCreate);
  144.   try
  145.     Stream.WriteComponent(PointList);
  146.   finally
  147.     Stream.Free;
  148.   end;
  149.   ClearPoints;
  150.   PaintBox1.Invalidate;
  151. end;
  152.  
  153. procedure TForm1.LoadBtnClick(Sender: TObject);
  154. var
  155.   Stream: TFileStream;
  156. begin
  157.   ClearPoints;
  158.   Stream := TFileStream.Create(DataFile, fmOpenRead or fmShareDenyWrite);
  159.   try
  160.     Stream.ReadComponent(PointList);
  161.   finally
  162.     Stream.Free;
  163.   end;
  164.   PaintBox1.Invalidate;
  165. end;
  166.  
  167. procedure TForm1.SwapBtnClick(Sender: TObject);
  168. begin
  169.   for Loop := 0 to PointList.ComponentCount - 1 do
  170.     (PointList.Components[Loop] as TPointData).SwapXY;
  171.   PaintBox1.Invalidate;
  172. end;
  173.  
  174. initialization
  175.   Randomize;
  176.   RegisterClass(TPointData);
  177. end.
  178.